home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / PROBKS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  561b  |  27 lines
  1. FUNCTION probks(alam: real): real;
  2. LABEL 1;
  3. CONST
  4.    eps1=0.001;
  5.    eps2=1.0e-8;
  6. VAR
  7.    a2,fac,sum,term,termbf: real;
  8.    j: integer;
  9. BEGIN
  10.    a2 := -2.0*alam*alam;
  11.    fac := 2.0;
  12.    sum := 0.0;
  13.    termbf := 0.0;
  14.    FOR j := 1 TO 100 DO BEGIN
  15.       term := fac*exp(a2*sqr(j));
  16.       sum := sum+term;
  17.       IF ((abs(term) < (eps1*termbf)) OR (abs(term) < (eps2*sum))) THEN BEGIN
  18.          probks := sum;
  19.          GOTO 1 END
  20.       ELSE BEGIN
  21.          fac := -fac;
  22.          termbf := abs(term)
  23.       END
  24.    END;
  25.    probks := 1.0;
  26. 1:   END;
  27.